create or replace package body m4o_lexer as

  C_MODULE constant m4o_module := new m4o_module('m4o_lexer');

  type rule_rec is record (
    pattern   varchar2(4000),
    ignore    boolean,
    match_pos pls_integer
  );
  type rule_tbl is table of rule_rec index by token_t;

  type matching_rules_tbl is table of boolean index by token_t;

  p_rules       rule_tbl;
  p_text        clob;
  p_current_pos pls_integer;
  p_cur         token_t;
  p_cur_text    m4o_v2.t;
  p_cur_length  pls_integer;

--------------------------------------------------------------------------------
  -- reset tokens
  procedure begin_define_tokens
  is
    v_pc m4o_context := C_MODULE.proc('begin_define_tokens');
  begin
    p_rules.delete;
  end;

--------------------------------------------------------------------------------
  procedure do_set_token(
    i_token   in token_t,
    i_pattern in varchar2)
  is
    v_pc m4o_context := C_MODULE.proc('do_set_token',
                                      m4o_v2tab(i_token,
                                                i_pattern));
    v_rule rule_rec;
  begin
    v_pc.assert(i_token is not null, 'Token-ID is required');

    v_rule.pattern := i_pattern;
    v_rule.ignore  := i_token = WS;
    p_rules(i_token)  := v_rule;
  end;
--------------------------------------------------------------------------------
  procedure set_whitespace(i_pattern in varchar2)
  is
    v_pc m4o_context := C_MODULE.proc('set_whitespace',
                                      m4o_v2tab(i_pattern));
  begin
    do_set_token(WS,i_pattern);
  end;
--------------------------------------------------------------------------------
  procedure set_token(
    i_token   in token_t,
    i_pattern in varchar2)
  is
    v_pc m4o_context := C_MODULE.proc('set_token',
                                      m4o_v2tab(i_token,
                                                i_pattern));
    v_rule rule_rec;
  begin
    v_pc.assert(i_token is not null, 'Token-ID is required');
    v_pc.assert(i_token > WS       , 'token numbers must be >= 1');

    v_pc.assert(not p_rules.exists(i_token),'Token '||i_token||' already set'); 

    do_set_token(i_token,i_pattern);
  end;
--------------------------------------------------------------------------------
  procedure begin_reading(i_text in clob)
  is
    v_pc m4o_context := C_MODULE.proc('begin_reading');
    v_cur token_t;
  begin
    p_text        := i_text;
    p_current_pos := 1;
    v_cur := p_rules.first;
    while v_cur is not null loop
      p_rules(v_cur).match_pos := null;
      v_cur := p_rules.next(v_cur);
    end loop;
    eat;
  end;
--------------------------------------------------------------------------------
  procedure end_reading
  is
    v_pc m4o_context := C_MODULE.proc('end_reading');
  begin
    eat(EOF);
  end;
--------------------------------------------------------------------------------
  function cur return token_t
  is
  begin
    return p_cur;
  end;
--------------------------------------------------------------------------------
  -- get current token string value
  function text return varchar2
  is
  begin
    return p_cur_text;
  end;
--------------------------------------------------------------------------------
  procedure eat
  is
    v_pc m4o_context := C_MODULE.proc('eat');
    v_cur        token_t;
    v_cur_text   m4o_v2.t;
    v_cur_length pls_integer;
  begin
    if p_text is null
       or p_current_pos > length(p_text) then
      p_cur := EOF;
      return;
    end if;

    p_cur        := EOF;
    p_cur_text   := null;
    p_cur_length := 0;
    v_cur := p_rules.first; 
    -- starting at p_current_pos, find
    while v_cur is not null loop
      /*
      v_pc.do('testing token #'
            ||v_cur
            ||', pattern "'
            ||p_rules(v_cur).pattern
            ||'" on "'
            ||substr(p_text,p_current_pos,30)
            ||'.."');
      */
      if p_rules(v_cur).match_pos = 0 then
        --v_pc.log('not found anymore');
        null;
      elsif p_rules(v_cur).match_pos is null
         or p_rules(v_cur).match_pos < p_current_pos then
        p_rules(v_cur).match_pos := regexp_instr(
                                      srcstr   => p_text,
                                      pattern  => p_rules(v_cur).pattern,
                                      position => p_current_pos,
                                      modifier => 'i');
      end if;
      if p_rules(v_cur).match_pos = p_current_pos then
        v_cur_text := regexp_substr(
                        srcstr   => p_text,
                        pattern  => p_rules(v_cur).pattern,
                        position => p_current_pos,
                        modifier => 'i');
        v_cur_length := length(v_cur_text);
        if v_cur_length > p_cur_length then
          p_cur        := v_cur;
          p_cur_text   := v_cur_text;
          p_cur_length := v_cur_length;
        end if;
      end if;

      v_cur := p_rules.next(v_cur);
    end loop;

    if p_cur is not null then
      p_current_pos := p_current_pos+p_cur_length;
    else
      v_pc.error('no token matches "'
               ||substr(p_text,p_current_pos,50)
               ||'..." at position #'
               ||p_current_pos);
    end if;

    if p_cur = WS then
      eat;
    end if;
  end;
--------------------------------------------------------------------------------
  procedure eat(i_token in token_t)
  is
    v_pc m4o_context := C_MODULE.proc('eat',
                                      m4o_v2tab(i_token));
    v_cur token_t;
  begin
    v_cur := cur;
    if v_cur = i_token then
      v_pc.log('##### matched "'
             ||p_cur_text
             ||'" at pos #'
             ||p_current_pos);
      eat;
    else
      v_pc.error('expecting "'
               ||p_rules(i_token).pattern
               ||'" (token #'
               ||i_token
               ||'), got '||v_cur);
    end if;
  end;
end;
/

